home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: MegaDisc / MegaDisc 36 (1993-11)(MegaDisc Digital Publishing)(AU)(Disk 2 of 2).zip / MegaDisc 36 (1993-11)(MegaDisc Digital Publishing)(AU)(Disk 2 of 2).adf / ARexx / Chars / CharsDemo < prev    next >
Text File  |  1993-09-17  |  4KB  |  124 lines
  1.  
  2.             /* Defined Characters Demo */    
  3.             /*     By John Collett     */
  4.  
  5.     lib.1 = 'rexxsupport.library' ; lib.2 = 'rexxarplib.library'
  6.     do i = 1 to 2
  7.      if ~show('l',lib.i) then check = addlib(lib.i,0,-30,0) 
  8.      end
  9.  
  10.     address AREXX '"call CreateHost(HO, PORT)"'    
  11.     if ~show('Ports','HO') then address command 'WaitForPort HO' 
  12.  
  13.     flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH'
  14.     idcmp = 'CLOSEWINDOW'
  15.     call OpenWindow(HO,50,20,550,180,idcmp,flags,'Character Displayer') 
  16.     call openport(PORT) ; call ActivateWindow(HO)
  17.     fileopen = 0 ; call CharFile()
  18.     if ~(fileopen) then signal 'finish'
  19.     t=time('r') ; call Apen(1)
  20.     call pat(16,24,'The following lines contain user-defined characters:')
  21.     call APen(2)
  22.     t = 'Examples of Greek characters are {alpha} and {beta}.'
  23.     call Chart(16,40,t) ; call Apen(1)
  24.     t = "In maths you may have used {pi} and {chi}."
  25.     call Chart(16,55,t) ; call Apen(2)
  26.     t = "The International Phonetics Alphabet, not hard to learn, uses"
  27.     call pat(16,70,t)
  28.     t = "symbols (enclosed in square brackets) to show pronunciation."
  29.     call pat(16,80,t)
  30.     t = "The French for 'cat' is 'chat', pronounced [{sh}{ah}]."
  31.     call Chart(16,90,t)
  32.     call Apen(1) ; t = "Adjacent characters can work together : "
  33.     t = t || "{zed1}{zed2}" ; call Chart(16,110,t)  
  34.      
  35.     t = time('r') ; call Apen(2)
  36.     call pat(46,130,'This screen took ' || t || ' seconds to process.')
  37.     call Apen(1)
  38.     t = 'If you need to use many special characters, then another'
  39.     call pat(46,140,t)
  40.     t = 'approach such as brush images may be better.  For occasional'
  41.     call pat(46,150,t)
  42.     t = 'needs, the method you have seen here may be adequate.'
  43.     call pat(46,160,t)
  44.  
  45.     do forever  
  46.      call waitpkt(PORT) ; p = getpkt(PORT)
  47.      if p ~== NULL() then                 
  48.       do                                  
  49.        i = getarg(p) ;  t = reply(p, 0)
  50.        parse var i class
  51.        if i = 'CLOSEWINDOW' then signal 'finish'
  52.        end 
  53.      end       
  54.     
  55.     finish:
  56.      if fileopen then cl = close(cf)  
  57.      call CloseWindow(HO)  
  58.      exit
  59.     
  60.     /*  F u n c t i o n s  */
  61.     pat:
  62.      if arg() = 4 then call APen(arg(4)) 
  63.      call Move(HO,arg(1),arg(2)) ; call Text(HO,arg(3))
  64.      return
  65.  
  66.     APen: call SetAPen(HO,arg(1)) ; return
  67.   
  68.     CharFile:
  69.       if ~fileopen then do
  70.         charfil = GetFile(160,30,,'chars','Character defs file')
  71.         if charfil ~= '' then do 
  72.           if exists(charfil) then do
  73.             op = open(cf,charfil,'r') ; fileopen = 1 ; end
  74.             else req = Request(160,30,'Character file not found',,'Okay')
  75.           end
  76.      return
  77.     
  78.     Chart:
  79.       x = arg(1) ; y = arg(2) ; txt = arg(3)
  80.       lastchar = (right(txt,1) = '}')           /* See note below */
  81.     
  82.     /* The following few lines replace '{   }'s with spaces, and return
  83.        the contents of '{   }'s as array elements */
  84.     
  85.      newtxt = '' ; n = 0
  86.      do until txt = ''
  87.       n = n + 1 
  88.       parse var txt t1 '{' txt ; parse var txt t2 '}' txt
  89.       newtxt = newtxt || t1 || ' ' ; label.n = t2 
  90.       pos.n = length(newtxt) - 1
  91.      end
  92.     
  93.     /* The next line is a fix for when the last part of the whole line is
  94.     not within braces. This had me puzzled for a while, but the fix works.
  95.      */
  96.  
  97.      if ~ lastchar then n = n - 1       
  98.      call pat(x,y,strip(newtxt)) ; y = y - 7
  99.  
  100.      do la = 1 to n 
  101.       p = seek(cf,0,'b') ; found = 0
  102.       do until found | eof(cf)
  103.         t = readln(cf) ; parse var t lab ',' parms .
  104.         found = (lab = label.la)
  105.         end
  106.        col = x + pos.la * 8
  107.        parse var parms a.1 ',' a.2 ',' a.3 ',' a.4 ',' a.5 ',',
  108.                        a.6 ',' a.7 ',' a.8 .
  109.        do j = 1 to 8
  110.          if a.j = 0 then iterate   /* All bits are zero ; no shading in */
  111.          row = y + j 
  112.     
  113.        /* Convert eight stored numbers to 1's and 0's  */
  114.          octet = c2b(d2c(a.j))
  115.            do bit = 1 to 8
  116.     
  117.              /* Shade in the bits which are a 1 */
  118.              if substr(octet,bit,1) then do
  119.                call Move(HO,col+bit,row); call Draw(HO,col+bit,row); end
  120.            end
  121.          end
  122.        end
  123.       return
  124.                 /*   E n d   */